Código
# Librerias
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(lubridate)
library(stringr)
library(writexl)
library(kableExtra)
library(plotly)# Librerias
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(lubridate)
library(stringr)
library(writexl)
library(kableExtra)
library(plotly)MANEJO DE DATOS
RONCAGLIA, Andrés | SANTINI, Franco
Primer trabajo práctico de Bioestadística
Facultad de Ciencias Económicas y Estadística, UNR
Se llevó a cabo un estudio de investigación clínica multicéntrico con el fin de implementar estándares mundiales de crecimiento fetal que faciliten la detección temprana de alteraciones en el desarrollo del feto dentro del últero, y de esta manera reducir la morbi-mortalidad perinatal asociada con el crecimiento. Durante el período de reclutamiento, las mujeres admitidas en alguna de las clínicas de salud participantes cursando su primer trimestre de embarazo fueron invitadas a formar parte del estudio. Aquellas que cumplieron con los criterios de elegibilidad y dieron su consentimiento fueron seguidas según un esquema de visitas programado a las 14, 18, 24, 28, 32, 36 y 40 semanas de gestación. En cada visita, se tomaron medidas antropométricas del feto por medio de un ultrasonido.
La información necesaria para llevar a cabo el análisis se recolectó a lo largo de 17 formularios en papel. Particularmente, en el formulario de admisión (ADM) se registraron algunas características de la mujeres al momento de ingresar en el estudio. A las mujeres que cumplieron todos los criterios les fue asignado un código identificador único (Subject Number) compuesto por su código de país, código del médico responsable, y el orden de ingreso. Sólo se entrevistaron mujeres mayores de edad (18 años o más al momento de la entrevista).
Estos datos son digitalizados manualmente lo cúal puede llevar a numerosas inconsistencias y errores ya sean por parte de quien completa el formulario y/o de quien lo digitaliza. Es importante entonces establecer un conjunto de reglas para que la información recopilada este limpia de estas inconsistencias, alertando cada vez que un registro viole alguna de las reglas, a esto lo llamamos validación.
# Carga de datos
datos <- read_xlsx('Datos/adm.xlsx')
# Extraemos la fecha de nacimiento y las inciales de la persona
ids <- str_split(datos$patientid, pattern = '-')
datos$bdate <- sapply(ids, function(x) x[1])
datos$initials <- sapply(ids, function(x) x[2])
# Pasamos a formato fecha las variables correspondientes y calculamos la edad antes de la entrevista
datos <- datos |> mutate(interview = as.Date(interview, format = '%d/%m/%Y'),
bdate = as.Date(bdate, format = '%d/%m/%Y'),
age = round(as.numeric(interview - bdate)/365,2),
ind_id = 1:nrow(datos))Las variables que se extrajeron de los formularios son las siguientes:
data.frame(Variable = names(datos)[1:8],
Tipo = c("Numérico", "Caracter", "Fecha", "Numérico", "Numérico", "Numérico", "Numérico", "Caracter"),
Descripcion = c("Código del país", "Identificador del paciente", "Fecha de la entrevista", "Grupo étnico", "Elegibilidad según forma CLIN-SCR", "Elegibilidad según forma US-SCR", "Consentimiento", "Número de sujeto"),
Valores = c("4, 11, 14, 23, 31, 48, 54, 65, 72, 97", "dd/mm/yyyy-AA", "dd/mm/yyyy", "1 = 'Caucásico', 2 = 'Asiático', 3 = 'Africano', 4 = 'Otro'", "1 = 'NO', 2 = 'YES'", "1 = 'NO', 2 = 'YES'", "1 = 'NO', 2 = 'YES'", "countrycode-physiciancode-subjectcode")
) |> kable(format = 'pipe') |>
kable_styling() %>%
row_spec(0, background = "skyblue2", color = "black", bold = T) %>%
row_spec(1:8, background = "#f2f3f4" ,color = "black")| Variable | Tipo | Descripcion | Valores |
|---|---|---|---|
| countrycode | Numérico | Código del país | 4, 11, 14, 23, 31, 48, 54, 65, 72, 97 |
| patientid | Caracter | Identificador del paciente | dd/mm/yyyy-AA |
| interview | Fecha | Fecha de la entrevista | dd/mm/yyyy |
| ethnicgroup | Numérico | Grupo étnico | 1 = 'Caucásico', 2 = 'Asiático', 3 = 'Africano', 4 = 'Otro' |
| scr | Numérico | Elegibilidad según forma CLIN-SCR | 1 = 'NO', 2 = 'YES' |
| usscr | Numérico | Elegibilidad según forma US-SCR | 1 = 'NO', 2 = 'YES' |
| consent | Numérico | Consentimiento | 1 = 'NO', 2 = 'YES' |
| subjectnumber | Caracter | Número de sujeto | countrycode-physiciancode-subjectcode |
A partir de estas variables, se crearon las siguientes:
data.frame(Variable = names(datos)[9:length(names(datos))],
Tipo = c("Fecha", "Caracter", "Numérico", "Numérico"),
Descripcion = c("Fecha de nacimiento", "Iniciales del paciente", "Edad del paciente", "Identificador numérico del paciente"),
Valores = c("dd/mm/yyyy", "AA", "18 a 51", "1 a 1000")
) |> kable(format = 'pipe') |>
kable_styling() %>%
row_spec(0, background = "skyblue2", color = "black", bold = T) %>%
row_spec(1:4, background = "#f2f3f4" ,color = "black")| Variable | Tipo | Descripcion | Valores |
|---|---|---|---|
| bdate | Fecha | Fecha de nacimiento | dd/mm/yyyy |
| initials | Caracter | Iniciales del paciente | AA |
| age | Numérico | Edad del paciente | 18 a 51 |
| ind_id | Numérico | Identificador numérico del paciente | 1 a 1000 |
Dada la naturaleza del problema se definieron las siguientes reglas:
#https://centrofertilidad.com/blog/hasta-que-edad-una-mujer-es-fertil/#elementor-toc__heading-anchor-0
# Creacion de reglas --------------------
## Condiciones de las reglas ----------------
condiciones = c(
'is.na(countrycode)',
'!is.numeric(countrycode)',
'!(countrycode %in% c(4,11,14,23,31,48,54,65,72,97))',
'is.na(patientid)',
'is.na(bdate)',
'!is.Date(bdate)',
'is.na(initials)',
'!is.character(initials)',
'str_length(initials) != 2',
'initials != str_to_upper(initials)',
'is.na(interview)',
'!is.Date(interview)',
'age < 18 | age > 51',
'is.na(ethnicgroup)',
'!is.numeric(ethnicgroup)',
'!(ethnicgroup %in% 1:4)',
'is.na(scr)',
'!is.numeric(scr)',
'!(scr %in% 1:2)',
'is.na(usscr)',
'!is.numeric(usscr)',
'!(usscr %in% 1:2)',
'is.na(consent)',
'!is.numeric(consent)',
'!(consent %in% 1:2)',
'(consent == 1 | scr == 1 | usscr == 1) & !(is.na(subjectnumber))',
'(consent == 2 & scr == 2 & usscr == 2) & is.na(subjectnumber)',
'ifelse(is.na(subjectnumber), FALSE, !(is.character(subjectnumber)))',
'ifelse(is.na(subjectnumber), FALSE, str_length(subjectnumber) != 9)',
'ifelse(is.na(subjectnumber), FALSE, as.numeric(str_sub(subjectnumber, end = 3)) != countrycode)'
)
## Descripcion de las reglas --------------------
desc <- c(
'(countrycode) es faltante',
'(countrycode) no es numérica',
'(countrycode) no está entre las opciones',
'(patientid) es faltante',
'(bdate) es faltante',
'(bdate) no es fecha',
'(initials) es faltante',
'(initials) no es caracter',
'(initials) no es de largo 2',
'(initials) no está en mayusculas',
'(interview) es faltante',
'(interview) no es fecha',
'(age) fuera de rango (18 <= age <= 51)',
'(ethnicgroup) es faltante',
'(ethnicgroup) no es numérica',
'(ethnicgroup) no está entre las opciones',
'(scr) es faltante',
'(scr) no es numérica',
'(scr) no está entre las opciones',
'(usscr) es faltante',
'(usscr) no es numérica',
'(usscr) no está entre las opciones',
'(consent) es faltante',
'(consent) no es numérica',
'(consent) no está entre las opciones',
'Si (scr), (usscr) o (consent) igual a 1, (subjectnumber) debe ser faltante',
'Si (scr), (usscr) y (consent) igual a 2, (subjectnumber) no debe ser faltante',
'Si (subjectnumber) no es faltante, (subjectnumber) debe ser caracter',
'Si (subjectnumber) no es faltante, el largo de (subjectnumber) debe ser igual a 9',
'Si (subjectnumber) no es faltante, los 3 primeros valores de (subjectnumber) deben coincidir con (countrycode)'
)
campo <- c(
'Country Code',
'Country Code',
'Country Code',
'Patients ID',
'Patients ID',
'Patients ID',
'Patients ID',
'Patients ID',
'Patients ID',
'Patients ID',
'Interview',
'Interview',
'Patients ID',
'Ethnic Group',
'Ethnic Group',
'Ethnic Group',
'SSR',
'SSR',
'SSR',
'USSSR',
'USSSR',
'USSSR',
'Consent',
'Consent',
'Consent',
'Subject Number',
'Subject Number',
'Subject Number',
'Subject Number',
'Subject Number'
)
tipo = c(
"Existencia",
"Consistencia",
"Rango",
"Existencia",
"Existencia",
"Consistencia",
"Existencia",
"Consistencia",
"Rango",
"Rango",
"Existencia",
"Consistencia",
"Rango",
"Existencia",
"Consistencia",
"Rango",
"Existencia",
"Consistencia",
"Rango",
"Existencia",
"Consistencia",
"Rango",
"Existencia",
"Consistencia",
"Rango",
"Consistencia",
"Consistencia",
"Consistencia",
"Consistencia",
"Consistencia"
)
id = paste0('r.', 1:length(condiciones))
## Dataframe reglas ------------------------
reglas <- data.frame(
id = id,
descripcion = desc,
condicion = condiciones,
tipo = tipo,
campo = campo
)
## Guardamos las reglas como excel
write_xlsx(x = reglas, path = 'conjunto_validacion.xlsx')kable(reglas, col.names = c("ID", "Descripción", "Condición", "Tipo", "Campo")) |>
kable_styling() %>%
row_spec(0, background = "skyblue2", color = "black", bold = T) %>%
row_spec(1:nrow(reglas), background = "#f2f3f4" ,color = "black") |>
scroll_box(height = '300px')| ID | Descripción | Condición | Tipo | Campo |
|---|---|---|---|---|
| r.1 | (countrycode) es faltante | is.na(countrycode) | Existencia | Country Code |
| r.2 | (countrycode) no es numérica | !is.numeric(countrycode) | Consistencia | Country Code |
| r.3 | (countrycode) no está entre las opciones | !(countrycode %in% c(4,11,14,23,31,48,54,65,72,97)) | Rango | Country Code |
| r.4 | (patientid) es faltante | is.na(patientid) | Existencia | Patients ID |
| r.5 | (bdate) es faltante | is.na(bdate) | Existencia | Patients ID |
| r.6 | (bdate) no es fecha | !is.Date(bdate) | Consistencia | Patients ID |
| r.7 | (initials) es faltante | is.na(initials) | Existencia | Patients ID |
| r.8 | (initials) no es caracter | !is.character(initials) | Consistencia | Patients ID |
| r.9 | (initials) no es de largo 2 | str_length(initials) != 2 | Rango | Patients ID |
| r.10 | (initials) no está en mayusculas | initials != str_to_upper(initials) | Rango | Patients ID |
| r.11 | (interview) es faltante | is.na(interview) | Existencia | Interview |
| r.12 | (interview) no es fecha | !is.Date(interview) | Consistencia | Interview |
| r.13 | (age) fuera de rango (18 <= age <= 51) | age < 18 | age > 51 | Rango | Patients ID |
| r.14 | (ethnicgroup) es faltante | is.na(ethnicgroup) | Existencia | Ethnic Group |
| r.15 | (ethnicgroup) no es numérica | !is.numeric(ethnicgroup) | Consistencia | Ethnic Group |
| r.16 | (ethnicgroup) no está entre las opciones | !(ethnicgroup %in% 1:4) | Rango | Ethnic Group |
| r.17 | (scr) es faltante | is.na(scr) | Existencia | SSR |
| r.18 | (scr) no es numérica | !is.numeric(scr) | Consistencia | SSR |
| r.19 | (scr) no está entre las opciones | !(scr %in% 1:2) | Rango | SSR |
| r.20 | (usscr) es faltante | is.na(usscr) | Existencia | USSSR |
| r.21 | (usscr) no es numérica | !is.numeric(usscr) | Consistencia | USSSR |
| r.22 | (usscr) no está entre las opciones | !(usscr %in% 1:2) | Rango | USSSR |
| r.23 | (consent) es faltante | is.na(consent) | Existencia | Consent |
| r.24 | (consent) no es numérica | !is.numeric(consent) | Consistencia | Consent |
| r.25 | (consent) no está entre las opciones | !(consent %in% 1:2) | Rango | Consent |
| r.26 | Si (scr), (usscr) o (consent) igual a 1, (subjectnumber) debe ser faltante | (consent == 1 | scr == 1 | usscr == 1) & !(is.na(subjectnumber)) | Consistencia | Subject Number |
| r.27 | Si (scr), (usscr) y (consent) igual a 2, (subjectnumber) no debe ser faltante | (consent == 2 & scr == 2 & usscr == 2) & is.na(subjectnumber) | Consistencia | Subject Number |
| r.28 | Si (subjectnumber) no es faltante, (subjectnumber) debe ser caracter | ifelse(is.na(subjectnumber), FALSE, !(is.character(subjectnumber))) | Consistencia | Subject Number |
| r.29 | Si (subjectnumber) no es faltante, el largo de (subjectnumber) debe ser igual a 9 | ifelse(is.na(subjectnumber), FALSE, str_length(subjectnumber) != 9) | Consistencia | Subject Number |
| r.30 | Si (subjectnumber) no es faltante, los 3 primeros valores de (subjectnumber) deben coincidir con (countrycode) | ifelse(is.na(subjectnumber), FALSE, as.numeric(str_sub(subjectnumber, end = 3)) != countrycode) | Consistencia | Subject Number |
# Evaluacion de reglas ------------------
# Funcion validador()
# argumentos:
# - datos: conjunto de validacion
# - id : nombre de la columna en (datos) con el identificador
# - cond : nombre de la columna en (datos) con la condicion
# salida: vector nombrado
validador <- function(datos, id, cond) {
reglas = datos[[cond]]
names(reglas) = datos[[id]]
reglas
}
# Funcion validar()
# argumentos:
# - datos : conjunto de datos a validar
# - id : nombre de la columna en (datos) con el identificador
# - validador: salida de validador()
# salida: tibble con el resultado de la validación
validar <- function(datos, id, validador) {
sapply(
validador,
function(x) eval(parse(text = x), datos)
) |>
as.data.frame() |>
mutate(registro = datos[[id]], .before = 0)
}validacion <- validar(datos = datos, id = 'ind_id', validador = validador(datos = reglas, id = 'id', 'condicion'))
validacion_largo <- validacion |>
pivot_longer(-registro, names_to = 'Regla', values_to = 'Error')# Individuos limpios
limpios <- validacion_largo |>
group_by(registro) |>
summarise('Errores' = sum(ifelse(is.na(Error), 1, Error))) |>
ungroup() |>
filter(Errores == 0) |>
count() |>
as.numeric()
# Participantes con inconsistencias
no_limpios <- nrow(datos)-limpios
# Inconsistencias mas frecuentes
inconsistencias <- validacion_largo |>
group_by(Regla) |>
summarise(Frecuencia = sum(ifelse(is.na(Error), 1, Error))) |>
ungroup() |>
arrange(desc(Frecuencia)) |>
head(7) |>
left_join(reglas, by = c('Regla' = 'id')) |>
select(Regla, descripcion, Frecuencia)
# Campos con mas errores
campos <- validacion_largo |>
group_by(Regla) |>
summarise(Frecuencia = sum(ifelse(is.na(Error), 1, Error))) |>
ungroup() |>
left_join(reglas, by = c('Regla' = 'id')) |>
group_by(campo) |>
summarise(Frecuencia = sum(Frecuencia))Resultó de interés conocer las respuestas a las siguientes preguntas:
¿Cúal es el número de participantes limpios (sin inconsistencias)?
Hay un total de 761 pacientes sin inconsitencias.
¿Cúantos participantes tienen inconsistencias?
Dado que el total de pacientes son 1000, la cantidad de pacientes que tienen al menos una inconsistencia es 239.
¿Cúales son las inconsistencias más frecuentes?
a <- ggplot(inconsistencias) +
aes(x = reorder(Regla, Frecuencia), y = Frecuencia, text = descripcion) +
geom_col(color = "black", fill = "firebrick", alpha = 0.7) +
theme_bw() +
xlab("Regla") +
ggtitle("Top 7 inconsistencias más frecuentes") +
theme(legend.position = "none")
ggplotly(a, tolltip = "text")b <- campos |>
filter(Frecuencia > 0) |>
ggplot() +
aes(x = reorder(campo, Frecuencia), y = Frecuencia) +
geom_col(color = "black", fill = "dodgerblue", alpha = 0.7) +
theme_bw() +
xlab("Campo") +
ggtitle("Cantidad de errores por campo") +
theme(legend.position = "none")
ggplotly(b)En base a los errores más comunes se debería recomendar a las personas que registran y digitalizan la información que presten más atención a los campos referidos al grupo étnico y al identificador del sujeto, en especial a las reglas 14, 30, 16, 26 y 27 que son las que se rompen con mayor frecuencia. Esto aceleraría el proceso de validación de datos logrando tener la información lista para el análisis en menor tiempo y con mayor calidad.